home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 4 / Mac Giga-ROM 4.0 - 1993.toast / FILES / DEV / I-Z / ViewIt™ Shareware.sea / ViewIt™ 2.04 Shareware / Projects / Fortran Demos / FaceProcAF.inc next >
Text File  |  1992-07-11  |  3KB  |  88 lines
  1. C FaceWare 2.02 Initialization & Dispatching Procedures
  2. C ©FaceWare 1989-92.  All Rights Reserved.
  3.  
  4.     SUBROUTINE FaceIt(xPtr,m1,m2,m3,m4,m5)
  5.     implicit none
  6.     integer*4 JumpIt
  7.     inline (JumpIt = /z'2257',z'2051',z'4e90'/)
  8.     integer*4 xPtr,m1,m2,m3,m4,m5,i,restype,thePtr,fPtr
  9.       record /FaceRec/ fRec
  10.       common/FaceStuff/fRec
  11.     thePtr = xPtr
  12.     fPtr = %loc(fRec)
  13.     if (m1 == -61) then
  14.       if ((m4 > -1).and.((m4.and.1) == 0)) then
  15.         call FlushEvents(%val2(62),%val2(0)) !ignore spurious mouse & key events
  16.       end if
  17.       fRec.uName = char(len(trim(fRec.uName)))//fRec.uName
  18.       restype = z'46434D44' != "FCMD", find LoadIt or quit to Finder
  19.       if (GetResource(%val4(restype),%val2(1000)) == 0) then
  20.         if (OpenResFile(fRec.uName) < 0) stop
  21.       end if
  22.       fRec.fFlags = m2         !store FaceIt bit flags
  23.       fRec.xEntries = m5         !store # of table entries
  24.       thePtr = fPtr
  25.       if (m3 > -1) then           !call LoadIt to expand heap?
  26.         call PrepIt(thePtr,m3,0,0,thePtr)
  27.         call JumpIt(%val4(thePtr))
  28.       end if
  29.       call PrepIt(thePtr,1100,20,0,thePtr)      !setup fRec header
  30.       call PrepIt(thePtr+552,1130,10,0,thePtr)  !setup dRec header
  31.       call PrepIt(thePtr+1002,1110,20,0,thePtr) !setup uRec header
  32.       call PrepIt(thePtr+1634,1200,20,0,thePtr) !setup vRec header
  33.       fRec.fHead(6) = m4           !store environment type
  34.       fRec.uHead(6) = 2            !establish string type
  35.       thePtr = 0
  36.       if (m4 < -3) return
  37.     end if
  38.     if (m1 == -62) then
  39.       call PrepIt(m2,m3,m4,m5,fPtr)
  40.     else if ((m1 < 0).and.(m1 > -11)) then
  41.       i = (4 * (-1 - m1))
  42.       fRec.xTable(1+i) = m2
  43.       fRec.xTable(2+i) = m3
  44.       fRec.xTable(3+i) = m4
  45.       fRec.xTable(4+i) = m5
  46.     else
  47.       if (thePtr == 0) then      !call to default module?
  48.         thePtr = fPtr + 1002
  49.       else if (long(thePtr + 12) <> fPtr) then
  50.         fRec.cControl = thePtr   !call to control driver?
  51.         thePtr = fPtr + 1634
  52.       end if
  53.       word(thePtr + 8) = 0
  54.       fRec.uCommand = m1         !pass Command & Params
  55.       fRec.uParam(1) = m2
  56.       fRec.uParam(2) = m3
  57.       fRec.uParam(3) = m4
  58.       fRec.uParam(4) = m5
  59.       call JumpIt(%val4(thePtr)) !jump to FCMD module
  60.     end if
  61.     end
  62.  
  63.     SUBROUTINE PrepIt(x,b,v,r,f)
  64.     implicit none
  65.     integer*4 x,b,v,r,f,i,restype,resptr
  66.       record /FaceRec/ fRec
  67.       common/FaceStuff/fRec
  68.     restype = z'46434D44' != "FCMD"
  69.     resptr = long(GetResource(%val4(restype),%val2(1000)))
  70.     long(x) = resptr
  71.     word(x+4) = b    !baseID
  72.     word(x+6) = v    !versID
  73.     word(x+8) = 0    !message
  74.     word(x+10) = r    !resID
  75.     long(x+12) = f    !fPtr
  76.     if (fRec.xEntries > 0) then
  77.      do (i = 0, fRec.xEntries-1)
  78.       if (b == fRec.xTable(1 + 4*i)) then
  79.        if (v == fRec.xTable(2 + 4*i)) then
  80.         if (0 <> fRec.xTable(4 + 4*i)) then
  81.          long(x) = fRec.xTable(4 + 4*i)
  82.         end if
  83.        end if
  84.       end if
  85.      end do
  86.     end if
  87.     end
  88.